Washington University Medical Center Redevelopment Corporation is a partnership between BJC Health Care and Washington University School of Medicine and works to improve the quality of life for the neighborhoods surrounding the medical campus. In order to achieve this goal in Forest Park Southeast and the Central West End , WUMCRC has invested millions of dollars toward regenerating the market for private investment in businesses and real estate, enhancing human and social service opportunities, and improving the level of physical and personal security.
One way we work to improve the level of physical & personal security is the analysis and distribution of data. The original source of this crime data is http://slmpd.org/crimereports.shtml. This notebook uses primarily compstatr to access and clean the crime data.
i <- cs_create_index()
update <- cs_last_update()
update <- strsplit(update, " ")[[1]]
c_month <- update[[1]]
c_year <- as.numeric(update[[2]])
yearList19 <- cs_get_data(year = c_year, index = i)
cs_validate(yearList19, year = 2019)
[1] TRUE
totalCrimes19 <- cs_collapse(yearList19)
print(c_month)
[1] "August"
crimes19 <- cs_extract_month(yearList19, month = "August")
cs_filter_count removes negative counts. Negative counts, -1, in the count column means that the crime, or charge in this specific observation has either been deemed unfounded, or the crime has been up coded. We do not want to map this data.
Many of the analyses we conduct include comparisons between violent & non-violent crime, comparisons on the amount of crimes happening in each crime cateogy over time, and if crimes occur during the day or at night. The following code ceates variables to conduct these analyses.
cs_crime_cat creates a variable with the names of the crime.
cs_crime creates a logic variable and codes violent crimes as TRUE and non-violent crimes as FALSE
cs_parse_date creates two columns separating the Date Occur variable. The two colums are as follows: one contains the date - month, date, and year, and the other contains the hour and minute. This is used because crimes coded in the most recent month, can contain dates that occured, in previous months or years & in this report we only want to map the crimes that occured in the past month.
filter is a dplyr function that filters out any dates that occur before the our selected date, and also filters out crimes that did not happen in either District 2 or district 5.
mutate adds a variable that codes and labels the days of the week for each crime that occurred, and creates another time of day variable
tidyCrimes19 <- crimes19 %>%
cs_filter_count(., var = count) %>%
cs_filter_crime(., var = crime, "part 1") %>%
cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
cs_crime_cat(., var = crime, crimeCatName, "string") %>%
cs_crime(., var = crime, violent, "violent") %>%
cs_crime(., var = crime, property, "property") %>%
cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
filter(dateOcc >= as.Date("2019-08-01")) %>%
filter(district == 2 | district == 5) %>%
mutate(weekday = wday(dateOcc, label = TRUE)) %>%
mutate(tod = timeOcc)
tidyCrimes19$neighborhood <- as.numeric(tidyCrimes19$neighborhood)
strptime and format takes the new time variable and formats it to a character so that we can determine if the crime occured at day or at night, and creates a second coded variable that labels each observations as day or night based on the newly formated time variable.
select drops the unneeded variables.
cs_missing_XY determines what data does not have x & y coordinates, and therefore cannot be accurately mapped.
cs_replace0 replaces missing x & y coordinates with NA, and drops the missing data.
tidyCrimes19$tod <- strptime(tidyCrimes19$tod, tz = "America/Chicago", "%H:%M")
tidyCrimes19$tod <- format(tidyCrimes19$tod, format = "%H%M%S")
tidyCrimes19 <- tidyCrimes19 %>%
mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>%
dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)
tidyCrimes19 <- cs_missingXY(tidyCrimes19, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyCrimes19$missing)
FALSE TRUE
735 4
tidyCrimes19 <- tidyCrimes19 %>%
cs_replace0(., var = x_coord) %>%
cs_replace0(., var = y_coord) %>%
filter(., missing == FALSE)
yearList18 <- cs_get_data(year = 2018, index = i)
cs_validate(yearList18, year = 2018)
[1] TRUE
totalCrimes18 <- cs_collapse(yearList18)
crimes18 <- cs_extract_month(yearList18, month = "August")
tidyCrimes18 <- crimes18 %>%
cs_filter_count(., var = count) %>%
cs_filter_crime(., var = crime, "part 1") %>%
cs_crime_cat(., var = crime, crimeCatNum, "numeric") %>%
cs_crime_cat(., var = crime, crimeCatName, "string") %>%
cs_crime(., var = crime, violent, "violent") %>%
cs_crime(., var = crime, property, "property") %>%
cs_parse_date(., date_occur, dateVar = dateOcc, timeVar = timeOcc) %>%
filter(dateOcc >= as.Date("2018-08-01") & dateOcc <= as.Date("2018-08-31")) %>%
filter(district == 2 | district == 5) %>%
mutate(weekday = wday(dateOcc, label = TRUE)) %>%
mutate(tod = timeOcc)
tidyCrimes18$neighborhood <- as.numeric(tidyCrimes18$neighborhood)
tidyCrimes18$tod <- strptime(tidyCrimes18$tod, tz = "America/Chicago", "%H:%M")
tidyCrimes18$tod <- format(tidyCrimes18$tod, format = "%H%M%S")
tidyCrimes18 <- tidyCrimes18 %>%
mutate(., dayNight = ifelse(tod >= "180000" & tod < "600000", "Night", "Day")) %>%
dplyr::select(-dateTime, -tod, -flag_crime, -flag_administrative, -flag_unfounded, -flag_cleanup)
tidyCrimes18 <- cs_missingXY(tidyCrimes18, varX = x_coord, varY = y_coord, newVar = missing)
table(tidyCrimes18$missing)
FALSE TRUE
747 9
tidyCrimes18 <- tidyCrimes18 %>%
cs_replace0(., var = x_coord) %>%
cs_replace0(., var = y_coord) %>%
filter(., missing == FALSE)
augustCrimes <- rbind(tidyCrimes18, tidyCrimes19)
crimes18_sf <- cs_projectXY(tidyCrimes18, varX = x_coord, varY = y_coord, crs = 102696)
crimes19_sf <- cs_projectXY(tidyCrimes19, varX = x_coord, varY = y_coord, crs = 102696)
augustCrimes_sf <- cs_projectXY(augustCrimes, varX = x_coord, varY = y_coord, crs = 102696)
sa <- c(39,28,38,51,53,54,58,46,47,48,48)
dst2 <- c(7:15,27:29, 39:45,81,82,87,88)
dst5 <- c(38,46:58,78)
One way we work to improve the level of physical & personal security is the analysis and distribution of crime data and statistics. The original source of this crime data is http://slmpd.org/crimereports.shtml. This notebook takes the data that was previously cleaned and maps the data.
xyfpse <- c(-90.2679, -90.2423, 38.6176, 38.6334)
xycwe <- c(-90.2759, -90.2368, 38.6286, 38.6552)
xybot <- c(-90.2619, -90.2409, 38.6165, 38.6296)
xydbp <- c(-90.2869, -90.2726, 38.6433, 38.6566)
xysdb <- c(-90.3026, -90.2827, 38.6456, 38.6571)
xywe <- c(-90.3020, -90.2712, 38.6517, 38.6710)
xyvp <- c(-90.2803, -90.2712, 38.6517, 38.6622)
xyac <- c(-90.2744, -90.2609, 38.6505, 38.6661)
xyfp <- c(-90.2648, -90.2543, 38.6493, 38.6655)
xylp <- c(-90.2588, -90.2437, 38.6481, 38.6624)
xyvd <- c(-90.2520, -90.2304, 38.6426, 38.6585)
xymc <- c(-90.2678, -90.2515, 38.6305, 38.6411)
xyctx <- c(-90.2581, -90.2419, 38.6299, 38.6386)
xygrv <- c(-90.2662, -90.2440, 38.6238, 38.6318)
xydst2 <- c(-90.3203, -90.2297, 38.5613, 38.6493)
xydst5 <- c(-90.3080, -90.2132, 38.6273, 38.6962)
nhoods_sf <- gw_get_data("Neighborhoods", "sf") %>%
rename(neighborhood = NHD_NUM)
trying URL 'https://www.stlouis-mo.gov/data/upload/data-files/nbrhds_wards.zip'
Content type 'application/x-zip-compressed' length 184305 bytes (179 KB)
downloaded 179 KB
sa_sf <- nhoods_sf %>%
filter(., NHD_NUM %in% sa) %>%
fpse <- filter(nhoods_sf, NHD_NUM == 39 )
Error in !inherits(x, "sf") : object 'NHD_NUM' not found
load(here("data/nbhd_pop10.rda"))
dst_2 <- tidyCrimes19 %>%
filter(., neighborhood %in% dst2) %>%
group_by(., neighborhood) %>%
count() %>%
rename(crimeTotal = n) %>%
left_join(nbhd_pop10, by = "neighborhood") %>%
mutate(., crimeRate = (crimeTotal/pop10)*1000) %>%
drop_na()
dst_2_pop <- left_join(nhoods_sf, dst_2, by = "neighborhood") %>%
st_transform(crs = 102696) %>%
drop_na() %>%
subset(., neighborhood != 88)
# dst2 <- left_join(nhoods_sf, by = "neighborhood")
dst_5 <- tidyCrimes19 %>%
filter(., neighborhood %in% dst5) %>%
group_by(., neighborhood) %>%
count() %>%
rename(crimeTotal = n) %>%
left_join(nbhd_pop10, by = "neighborhood") %>%
mutate(., crimeRate = (crimeTotal/pop10)*1000) %>%
drop_na()
dst_5_pop <- left_join(nhoods_sf, dst_5, by = "neighborhood") %>%
st_transform(crs = 102696) %>%
drop_na()
fpse_total_tm <- tm_shape(fpse_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 39) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 39) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "FPSE Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
fpse_total_tm
fpse_dn_tm <- tm_shape(fpse_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 39) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 39) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "dayNight",
palette = "-RdBu",
title.col = "Time of Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "FPSE Time of Crimes - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
fpse_dn_tm
fpse_vlnt_tm <- tm_shape(fpse_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 39) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 39) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "violent",
palette = "Reds",
title.col = "Violent") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "FPSE Violent Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
fpse_vlnt_tm
crimes19_sf %>%
filter(neighborhood == 39) %>%
smooth_map(., bandwidth = 0.5, style = "pretty",
cover = fpse) -> fpse_densities
|
| | 0%
|
|============= | 10%
|
|======================================= | 30%
|
|================================================================ | 50%
|
|========================================================================================== | 70%
|
|==================================================================================================================== | 90%
|
|=================================================================================================================================| 100%
fpse_den_tm <- tm_shape(fpse_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 39) %>%
tm_shape() +
tm_fill(col = NA,
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
tm_shape(fpse_densities$polygons) +
tm_fill(col = "level", palette = "BuPu", alpha = .60,
title = expression("Crimes per " * km^2)) +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "FPSE Crime Density - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
fpse_den_tm
grove_crimes <- st_intersection(crimes19_sf, grove_cid)
attribute variables are assumed to be spatially constant throughout all geometries
fpse_grove_tm <- tm_shape(grv_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 39) %>%
tm_shape() +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
tm_shape(grove_cid) +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 1,
lty = "solid") +
tm_shape(grove_crimes) +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "Grove CID Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
fpse_grove_tm
cwe_total_tm <- tm_shape(cwe_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 38) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "CWE Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
cwe_total_tm
cwe_dn_tm <- tm_shape(cwe_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 38) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "dayNight",
palette = "-RdBu",
title.col = "Time of Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "CWE Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
cwe_dn_tm
cwe_vlnt_tm <- tm_shape(cwe_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 38) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "violent",
palette = "Reds",
title.col = "Violent") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "CWE Time of Crimes - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "bottom"))
cwe_vlnt_tm
cwe_densities <- crimes19_sf %>%
filter(neighborhood == 38) %>%
smooth_map(., bandwidth = 0.5, style = "pretty",
cover = cwe)
|
| | 0%
|
|============= | 10%
|
|======================================= | 30%
|
|================================================================ | 50%
|
|========================================================================================== | 70%
|
|==================================================================================================================== | 90%
|
|=================================================================================================================================| 100%
cwe_den_tm <- tm_shape(cwe_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_fill(col = NA,
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
tm_shape(cwe_densities$polygons) +
tm_fill(col = "level", palette = "BuPu", alpha = .60,
title = expression("Crimes per " * km^2)) +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "CWE Crime Density- August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "top"))
cwe_den_tm
mc_crimes <- st_intersection(crimes19_sf, med_campus)
attribute variables are assumed to be spatially constant throughout all geometries
cwe_mc_tm <- tm_shape(mc_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
tm_shape(med_campus) +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 1,
lty = "solid") +
tm_shape(mc_crimes) +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "Med. Campus Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "top"))
cwe_mc_tm
ctx_crimes <- st_intersection(crimes19_sf, cortex)
attribute variables are assumed to be spatially constant throughout all geometries
cwe_ctx_tm <- tm_shape(ctx_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., NHD_NUM == 38) %>%
tm_shape() +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
tm_shape(cortex) +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 1,
lty = "solid") +
tm_shape(ctx_crimes) +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "Cortex Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = FALSE,
legend.position = c("right", "top"))
cwe_ctx_tm
bot_total_tm <- tm_shape(bot_tiles) +
tm_rgb() +
nhoods_sf %>%
filter(., neighborhood == 28) %>%
tm_shape() +
tm_fill(col = "#9ecae1",
alpha = .5) +
tm_borders(col = "black",
lwd = 2,
lty = "dashed") +
filter(crimes19_sf,
neighborhood == 28) %>%
tm_shape() +
tm_bubbles(size = .25,
col = "crimeCatName",
palette = "Set1",
title.col = "Part 1 Crimes") +
tm_credits("© Mapbox, © OpenStreetMap", position = c("left", "BOTTOM")) +
tm_layout(
main.title = "Botanical Heights Total Crime - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = TRUE,
legend.position = c("left", "top"))
bot_total_tm
dst2_rateMap <- tm_shape(dst2_tiles) +
tm_rgb() +
tm_shape(dst_2_pop) +
tm_polygons(col = "crimeRate",
palette = "BuPu",
style = "jenks",
title = "Crimes per 1,000 Residents") +
tm_text("neighborhood", shadow=TRUE) +
tm_layout(
main.title = "District 2 Crime Rates - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = TRUE,
legend.position = c("right", "bottom"))
dst2_rateMap
dst5_rateMap <- tm_shape(dst5_tiles) +
tm_rgb() +
tm_shape(dst_5_pop) +
tm_polygons(col = "crimeRate",
palette = "BuPu",
style = "jenks",
title = "Crimes per 1,000 Residents") +
tm_text("neighborhood", shadow=TRUE) +
tm_layout(
main.title = "District 5 Crime Rates - August 2019",
frame = FALSE,
legend.bg.color = "white",
legend.frame=TRUE,
legend.outside = TRUE,
legend.position = c("right", "bottom"))
dst5_rateMap